home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1995.rar / 1995 / OCT / CC9510 / strbox.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-21  |  13KB  |  496 lines
  1. unit StrBox;
  2. {$N+}
  3. interface
  4. uses
  5.   MathBox,
  6. {$IfDef Windows}
  7.   SysUtils;
  8. {$Else}
  9.   Dos;
  10. {$EndIf}
  11.  
  12. const
  13.   CR = #13#10;
  14.  
  15. type
  16.   Str12 = string[12];
  17.   DirStr = string[67];
  18.   PathStr = string[79];
  19.   NameStr = string[8];
  20.   ExtStr = string[4];
  21.  
  22. function Address2Str(Addr : Pointer) : string;
  23. function AddBackSlash(S: string): string;
  24. function CleanString(S: string): string;
  25. function GetFirstWord(S: string): string;
  26. function GetFirstToken(S: string; Token: Char): string;
  27. function GetHexWord(w: Word): string;
  28. function GetLastToken(S: string; Token: Char): string;
  29. function GetLogicalAddr(A: Pointer): Pointer;
  30. {$IfDef Windows}
  31. function GetTodayName(Pre, Ext: string): string;
  32. function GetTodaysDate: string;
  33. function GetTimeString: string;
  34. function GetTimeFormat: string;
  35. {$EndIf}
  36. function IsNumber(Ch: Char): Boolean;
  37. function LeftSet(src: string; Width:Integer; var Trunc: Boolean): String;
  38. function RightCharSet(Src: string; Width: Integer;
  39.                       Ch: Char; var Trunc: Boolean): string;
  40. function RemoveFirstWord(var S : String) : String;
  41. function ReverseStr(S: string): string;
  42. function Shorten(S: string; Cut: Integer): string;
  43. procedure SplitDirName(Path : PathStr; var Dir: DirStr; var WName: Str12);
  44. function StripBlanks(S: string): string;
  45. function StripFirstWord(S : string) : string;
  46. function StripFirstToken(S: string; Ch: Char): string;
  47. function StripFrontChars(S: string; Ch: Char): string;
  48. function StripFromFront(S: string; Len: Integer): string;
  49. function StripLastToken(S: string; Token: Char): string;
  50. implementation
  51. {$IfDef Windows}
  52. uses
  53.   Classes;
  54. {$EndIf}
  55.  
  56. function Address2Str(Addr : Pointer) : string;
  57. var
  58.   S1 : String;
  59.   S2 : String;
  60. begin
  61.   S1 := GetHexWord(Seg(Addr^));
  62.   S1 := S1 + ':';
  63.   S2 := GetHexWord(Ofs(Addr^));
  64.   S1 := S1 + S2;
  65.   Address2Str := S1;
  66. end;
  67.  
  68. function AddBackSlash(S: string): string;
  69. var
  70.  Temp: string;
  71. begin
  72.   Temp := S;
  73.   if S[Length(Temp)] <> '\' then
  74.     Temp := Temp + '\';
  75.   AddBackSlash := Temp;
  76. end;
  77.  
  78. {----------------------------------------------------
  79.        Name: CleanString function
  80. Declaration: CleanString(S: String): string;
  81.        Unit: StrBox
  82.        Code: S
  83.        Date: 05/05/94
  84. Description: Erase blanks from end and beginning of
  85.              a string
  86. -----------------------------------------------------}
  87. function CleanString(S: string): string;
  88. var
  89.   Temp: String;
  90. begin
  91.   Temp := StripFrontChars(S, #32);
  92.   Temp := StripBlanks(Temp);
  93.   CleanString := Temp;
  94. end;
  95.  
  96. {----------------------------------------------------
  97.        Name: GetFirstWord function
  98. Declaration: GetFirstWord(var S: string): string;
  99.        Unit: StrBox
  100.        Code: S
  101.        Date: 05/02/94
  102. Description: Get the first word from a string
  103. -----------------------------------------------------}
  104. function GetFirstWord(S : string) : string;
  105.   Var
  106.     i : Integer;
  107.     S1: String;
  108. begin
  109.   i := 1;
  110.   while (S[i] <> ' ') and (i < Length(S)) do begin
  111.      S1[i] := S[i];
  112.      Inc(i);
  113.   end;
  114.   Dec(i);
  115.   S1[0] := Chr(i);
  116.   GetFirstWord := S1;
  117. end;
  118.  
  119. function GetHexWord(w: Word): string;
  120. const
  121.   HexChars: array [0..$F] of Char =  '0123456789ABCDEF';
  122. var
  123.   Addr: string;
  124. begin
  125.   Addr[1] := hexChars[Hi(w) shr 4];
  126.   Addr[2] := hexChars[Hi(w) and $F];
  127.   Addr[3] := hexChars[Lo(w) shr 4];
  128.   Addr[4] := hexChars[Lo(w) and $F];
  129.   Addr[0] := #4;
  130.   GetHexWord := addr;
  131. end;
  132.  
  133. function GetFirstToken(S: string; Token: Char): string;
  134. var
  135.   Temp: string;
  136.   Index: INteger;
  137. begin
  138.   Index := Pos(Token, S);
  139.   if Index < 1 then begin
  140.     GetFirstToken := '';
  141.     Exit;
  142.   end;
  143.   Dec(Index); 
  144.   Move(S[1], Temp[1], Index);
  145.   Temp[0] := Chr(Index);
  146.   GetFirstToken := Temp;
  147. end;
  148.  
  149. { Get the last part of a string, from a token onward.
  150.   Given "Sam.Txt", and "." as a token, this returns "Txt" }
  151. function GetLastToken(S: string; Token: Char): string;
  152. var
  153.   Temp: string;
  154.   Index: INteger;
  155. begin
  156.   S := ReverseStr(S);
  157.   Index := Pos(Token, S);
  158.   if Index < 1 then begin
  159.     GetLastToken := '';
  160.     Exit;
  161.   end;
  162.   Dec(Index); 
  163.   Move(S[1], Temp[1], Index);
  164.   Temp[0] := Chr(Index);
  165.   GetLastToken := ReverseStr(Temp);
  166. end;
  167.  
  168. {----------------------------------------------------
  169.        Name: GetLogicalAddress function
  170. Declaration: GetLogicalAddr(A: Pointer): Pointer;
  171.        Unit: StrBox
  172.        Code: S
  173.        Date: 02/09/95
  174. Description: Enter a physical address and this function
  175.              will return a logical address.
  176. -----------------------------------------------------}
  177.  
  178. function GetLogicalAddr(A: Pointer): Pointer;
  179. var
  180.   APtr: Pointer;
  181. begin
  182.   if A = nil then exit;
  183.   if Ofs(A) = $FFFF then exit;
  184.   asm
  185.     mov ax, A.Word[0]
  186.     mov dx, A.Word[2]
  187.     mov es,dx
  188.     mov dx,es:Word[0]
  189.     mov APtr.Word[0], ax
  190.     mov APtr.Word[2], dx
  191.   end;
  192.   GetLogicalAddr := APtr;
  193. end;
  194.  
  195. {$ifdef Windows}
  196. function GetTimeString: string;
  197. var
  198.  h, m, s, hund : Word;
  199. begin
  200.   Result := TimeToStr(Time);
  201. end;
  202. {$Else}
  203. function GetTimeString: string;
  204. var
  205.  h, m, s, hund : Word;
  206. begin
  207.    GetTime(h,m,s,hund);
  208.    GetTimeString := Int2StrPad0(h, 2) + ':' +
  209.            Int2StrPad0(h, 2) + ':' + Int2StrPad0(s, 0) +
  210.            '.' + Int2StrPad0(hund, 2);
  211. end;
  212. {$endif}
  213.  
  214. {$IfDef Windows}
  215. function GetTimeFormat: string;
  216. var
  217.  h, m, s, hund : Word;
  218. begin
  219.    DecodeTime(Time, h, m, s, hund);
  220.    GetTimeFormat:= Int2StrPad0(h, 2) + ':' +
  221.            Int2StrPad0(m, 2) + ':' + Int2StrPad0(s, 2);
  222. end;
  223. {$EndIf}
  224.  
  225. {$IfDef Windows}
  226. {----------------------------------------------------
  227.        Name: GetTodayName function
  228. Declaration: GetTodayName(Pre, Ext: string): string;
  229.        Unit: StrBox
  230.        Code: S
  231.        Date: 03/01/94
  232. Description: Return a filename of type PRE0101.EXT,
  233.              where PRE and EXT are user supplied strings,
  234.              and 0101 is today's date.
  235. -----------------------------------------------------}
  236. function GetTodayName(Pre, Ext: string): string;
  237. var
  238.   y, m, d, dow : Word;
  239.   Year: String;
  240. begin
  241.   DecodeDate(Date,y,m,d);
  242.   Year := Int2StrPad0(y, 4);
  243.   Delete(Year, 1, 2);
  244.   GetTodayName := Pre + Int2StrPad0(m, 2) + Int2StrPad0(d, 2) +
  245.                     Year + '.' + Ext;
  246. end;
  247.  
  248. {----------------------------------------------------
  249.        Name: GetTodaysDate function
  250. Declaration: GetTodaysDate: string;
  251.        Unit: StrBox
  252.        Code: S
  253.        Date: 08/16/94
  254. Description: Return a string of type MM/DD/YY.
  255. -----------------------------------------------------}
  256. function GetTodaysDate: string;
  257. var
  258.   y, m, d, dow : Word;
  259.   Year: String;
  260. begin
  261.   DecodeDate(Date, y,m,d);
  262.   Year := Int2StrPad0(y, 4);
  263.   Delete(Year, 1, 2);
  264.   GetTodaysDate := Int2StrPad0(m, 2) + '/' + Int2StrPad0(d, 2) + '/' + Year;
  265. end;
  266. {$EndIf}
  267.  
  268. function IsNumber(Ch: Char): Boolean;
  269. begin
  270.   IsNumber := ((Ch >= '0') and (Ch <= '9'));
  271. end;
  272.  
  273. {----------------------------------------------------
  274.        Name: LeftSet function
  275. Declaration: LeftSet(src: string; Width: Integer;
  276.                      var Trunc: Boolean): string;
  277.        Unit: StrBox
  278.        Code: S
  279.        Date: 03/01/94
  280. Description: Pad a string on the left
  281. -----------------------------------------------------}
  282. function LeftSet(src: string; Width: Integer; var Trunc: Boolean): String;
  283. var
  284.   I : Integer;
  285.   Temp: string[80];
  286. begin
  287.   Trunc := False;
  288.   Temp := src;
  289.   if(Length(Temp) > Width) and (Width > 0) then begin
  290.     Temp[0] := CHR(Width);
  291.     Trunc := True;
  292.   end else
  293.     for i := Length(Temp) to width do
  294.       Temp := Temp + ' ';
  295.   LeftSet := Temp;
  296. end;
  297.  
  298. {----------------------------------------------------
  299.        Name: RemoveFirstWord function
  300. Declaration: RemoveFirstWord(var S : String) : String;
  301.        Unit: StrBox
  302.        Code: S
  303.        Date: 03/02/94
  304. Description: Strip the first word from a sentence,
  305.              return word and a shortened sentence.
  306.              Return an empty string if there is no
  307.              first word.
  308. -----------------------------------------------------}
  309. function RemoveFirstWord(var S : String) : String;
  310. var
  311.   i, Size: Integer;
  312.   S1: String;
  313. begin
  314.   i := Pos(#32,